home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / audit.tcl.z / audit.tcl
Text File  |  2002-07-08  |  4KB  |  126 lines
  1. #
  2. # audit.tcl --
  3. #    Leave an audit trail of operations on mail messages.
  4. #
  5. # Copyright 1995 Xerox Corporation All rights reserved.
  6. # License is granted to copy, to use, and to make and to use derivative works for
  7. # research and evaluation purposes, provided that the Xerox copyright notice and
  8. # this license notice is included in all copies and any derivatives works and in
  9. # all  related documentation.  Xerox grants no other licenses expressed or
  10. # implied and the licensee acknowleges that Xerox has no  liability for
  11. # licensee's use or for any derivative works  made by licensee. The Xerox  name
  12. # shall not be used in any advertising or the like without its written
  13. # permission.
  14. # This software is provided AS IS.  XEROX CORPORATION DISCLAIMS AND LICENSEE
  15. # AGREES THAT ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING WITHOUT LIMITATION
  16. # THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  17. # NOTWITHSTANDING ANY OTHER PROVISION CONTAINED HEREIN, ANY LIABILITY FOR DAMAGES
  18. # RESULTING FROM THE SOFTWARE OR ITS USE IS EXPRESSLY DISCLAIMED, INCLUDING
  19. # CONSEQUENTIAL OR ANY OTHER INDIRECT DAMAGES, WHETHER ARISING IN CONTRACT, TORT
  20. # (INCLUDING NEGLIGENCE) OR STRICT LIABILITY, EVEN IF XEROX CORPORATION IS
  21. # ADVISED OF THE POSSIBILITY OF SUCH DAMAGES."
  22.  
  23.  
  24.  
  25. proc Audit { event } {
  26.     after 1 [list AuditInner $event]
  27. }
  28. proc AuditInner { event } {
  29.     global audit
  30.     if ![info exists audit(file)] {
  31.     if [catch {open [Env_Tmp]/.exmhaudit.[pid] w 0600} audit(file)] {
  32.         Exmh_Status $audit(file)
  33.         set audit(file) {}
  34.     }
  35.     }
  36.     if {$audit(file) == {}} {
  37.     return
  38.     }
  39.     regexp {^([^     ]+)} $event key
  40.     if ![info exists audit(stat,$key)] { set audit(stat,$key) 0}
  41.     incr audit(stat,$key)
  42.     foreach ignore {folder} {
  43.     if {[string compare $key $ignore] == 0} {
  44.         return
  45.     }
  46.     }
  47.     puts $audit(file) $event
  48.     flush $audit(file)
  49. }
  50. proc Audit_Stats {} {
  51.     global exwin audit
  52.     set t .audit
  53.     if [Exwin_Toplevel .audit "Audit Stats" Audit] {
  54.     Widget_AddBut $t.but audit "Update Stats" Audit_Stats
  55.     FontWidget listbox $t.list -yscrollcommand "$t.scroll set" -setgrid true
  56.     scrollbar $t.scroll -command "$t.list yview"
  57.     pack $t.scroll $t.list -side $exwin(scrollbarSide)
  58.     pack $t.scroll -fill y
  59.     pack $t.list -fill both
  60.     }
  61.     $t.list delete 0 end
  62.     eval $t.list insert end [AuditGetStats]
  63.     catch {eval $t.list insert end Background [send $exmh(bgInterp) AuditGetStats]}
  64. }
  65. proc Audit_View {} {
  66.     global exwin audit
  67.     set t .auditview
  68.     if [Exwin_Toplevel $t "Audit View" Audit] {
  69.     if ![info exists audit(view)] {
  70.         set audit(view) Current
  71.     }
  72.     Widget_RadioBut $t.but cur "Current" audit(view) {right} \
  73.         -command {AuditLoad $audit(view)}
  74.     Widget_RadioBut $t.but past "Past" audit(view) {right} \
  75.         -command {AuditLoad $audit(view)}
  76.     set audit(text) [Widget_Text $t 20]
  77.     }
  78.     AuditLoad $audit(view)
  79.  
  80. }
  81. proc AuditLoad { view } {
  82.     global audit mhProfile
  83.     set t $audit(text)
  84.     switch -- $view {
  85.     Past { set path $mhProfile(path)/.exmhaudit }
  86.     Current -
  87.     default { set path [Env_Tmp]/.exmhaudit.[pid] }
  88.     }
  89.     $t delete 1.0 end
  90.     if [catch {open $path} in] {
  91.     $t insert end $in
  92.     } else {
  93.     $t insert end [read $in]
  94.     close $in
  95.     }
  96. }
  97. proc AuditGetStats {} {
  98.     global audit
  99.     set x {}
  100.     if [info exists audit] {
  101.     foreach index [lsort [array names audit]] {
  102.         if [regexp {^stat,(.+)} $index _ key] {
  103.         lappend x [format "%-10s %s" $key $audit($index)]
  104.         }
  105.     }
  106.     }
  107.     return $x
  108. }
  109. proc Audit_CheckPoint {} {
  110.     global audit mhProfile argv0
  111.     set file $audit(file)
  112.     unset audit(file)
  113.  
  114.     puts $file "$argv0 run ending: [exec date]\nStats\n"
  115.     foreach index [lsort [array names audit]] {
  116.     if [regexp {^stat,(.+)} $index x key] {
  117.         puts $file "$index $audit($index)"
  118.     }
  119.     unset audit($index)
  120.     }
  121.     close $file
  122.     exec cat [Env_Tmp]/.exmhaudit.[pid] >> $mhProfile(path)/.exmhaudit
  123.     Exmh_Status "Updated $mhProfile(path)/.exmhaudit"
  124.     File_Delete [Env_Tmp]/.exmhaudit.[pid]
  125. }
  126.